COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		 Here is the LISP source code required to answer HomeWork Set 3
C00005 00003	 (DIAGNOSIS PATIENTS DISEASES) 
C00006 00004	(DEFUN DIAGNOSES (PATIENTS DISEASES) 
C00009 ENDMK
C⊗;
	; Here is the LISP source code required to answer HomeWork Set 3
	; Spring 1979

(DEFUN PASS-NONE (PAT-HAS DIS-IS) 
  ; This returns T iff None of "PATient-HAS" is in "DISease-IS"
       (COND ((NULL DIS-IS) T)
             ((MEMQ (CAR DIS-IS) PAT-HAS) NIL)
             (T (PASS-NONE PAT-HAS (CDR DIS-IS))))) 

(DEFUN PASS-ALL (PAT-HAS DIS-IS) 
  ; This returns T iff All  of "PATient-HAS" is in "DISease-IS"
       (COND ((NULL DIS-IS) T)
             ((MEMQ (CAR DIS-IS) PAT-HAS)
              (PASS-ALL PAT-HAS (CDR DIS-IS)))
             (T NIL))) 

(DEFUN SELECT (CHECK-ME IF-PASS LIST) 
  ; This returns a list of elements derived as followed:
  ; x ε SELECT... => x = (if-pass y) where (check-me y) true, for some y ε LIST
       (COND ((NULL LIST) NIL)
             (T ((LAMBDA (CAR-LIST) (COND ((FUNCALL CHECK-ME CAR-LIST)
                                           (CONS (IF-PASS CAR-LIST)
                                                 (SELECT CHECK-ME
                                                         IF-PASS
                                                         (CDR LIST))))
                                          (T (SELECT CHECK-ME
                                                     IF-PASS
                                                     (CDR LIST)))))
                 (CAR LIST))))) 


(DEFUN DIAGNOSIS (P D) 
  ; Performs the diagnosis, given Patients, P, and Diseases, D
       (MAPCAR 
        '(LAMBDA (PAT) 
          (CONS
           (CAR PAT)
           ((LAMBDA (SYMP) 
                    (SELECT '(LAMBDA (DIS) 
                                     (AND (PASS-ALL SYMP (CADR DIS))
                                          (PASS-NONE SYMP
                                                     (CADDR DIS))))
                            'CAR
                            D))
            (CDR PAT))))
        P))
; (DIAGNOSIS PATIENTS DISEASES) 

; ((RDG FAIL-LISP-CLASS INSANITY HEALTHY) (DBL HEALTHY) (BCM 
; LACONIC-NESS) (CLEOPATRA CHICKEN-POX) (DOLLAR FAIL-LISP-CLASS 
; MIDAS-TOUCH INSANITY) (ICARUS FEAR-OF-FLYING HEALTHY) (FISHER 
; CHESS-ITIS HEALTHY) (PAULING HAYFEVER) (BIGMOUTH FAIL-LISP-CLASS 
; VERBOSITY INSANITY HEALTHY) (BIGMOUTH2 FAIL-LISP-CLASS LACONIC-NESS 
; INSANITY HEALTHY) (NOTHING HEALTHY) (DIRTYNEEDLE HEPATITUS) 
; (SMALLTALK LACONIC-NESS HEALTHY) (ROBBERBARON GERMAN-MEASLES) 
; (SICKIE) (MRHANGOVER TOOTHACHE STOMACHACHE)) 
(DEFUN DIAGNOSES (PATIENTS DISEASES) 
	  ; This is the overall function, which returns list of diagnoses.
       (MAPCAR 
	'(LAMBDA (PATIENT) (CONS (CAR PATIENT) (ONE-DIAGNOSIS PATIENT DISEASES)))
	PATIENTS)) 

(DEFUN ONE-DIAGNOSIS (PAT DIS) 
	   ; This determines which diseases the patient, PAT, has.
	   ; It uses list of dieseases, DIS.
       (MAPCHOOSE-1 '(LAMBDA( DISEASE ) (PROBABLY-HAS PAT DISEASE) )
		    DIS) )


(DEFUN MAPCHOOSE-1 (F U) 
	   ; This returns a list, whose elements are of the form (F u), where
	   ;   u ε U and (F u) is non-NIL
	   ;  [NOTE: MAPCHOOSE would have returned the element "u" if (↑) satisfied]
       (COND ((NULL U) NIL)
	     (((LAMBDA (TEST) 
	         (AND TEST (CONS test (MAPCHOOSE-1 F (CDR U)))))
			; if test is NIL, falls thru. Else, CONSes it to front
		(FUNCALL F (CAR U))))
	     (T (MAPCHOOSE-1 F (CDR U))))) 

(DEFUN ANDLIS (F X) 
       (COND ((NULL X) T)
	     (T (AND (APPLY F (LIST (CAR X))) (ANDLIS F (CDR X))))))